home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 2.iso / dist / fw_glimpse.idb / usr / freeware / src / glimpse-3.0 / libtemplate / template / soif.pl.z / soif.pl
Perl Script  |  1997-09-09  |  5KB  |  151 lines
  1. #-*-perl-*-
  2. #
  3. #  soif.pl - Processing for the SOIF format.
  4. #
  5. #  Darren Hardy, hardy@cs.colorado.edu, January 1995
  6. #
  7. #  $Id: soif.pl,v 1.6 1995/01/18 17:54:36 hardy Exp $
  8. #
  9. #######################################################################
  10. #  Usage:
  11. #
  12. #    require 'soif.pl';
  13. #    
  14. #    $soif'input = 'WHATEVER';     # defaults to STDIN
  15. #    ($ttype, $url, %SOIF) = &soif'parse();
  16. #    foreach $k (sort keys %SOIF) {
  17. #        print "KEY: $k\n";
  18. #        print "DATA: $SOIF{$k}\n";
  19. #    }
  20. #    exit(0);
  21. #    
  22. #######################################################################
  23. #  Copyright (c) 1994, 1995.  All rights reserved.
  24. #  
  25. #          Mic Bowman of Transarc Corporation.
  26. #          Peter Danzig of the University of Southern California.
  27. #          Darren R. Hardy of the University of Colorado at Boulder.
  28. #          Udi Manber of the University of Arizona.
  29. #          Michael F. Schwartz of the University of Colorado at Boulder. 
  30. #  
  31. #  This copyright notice applies to all code in Harvest other than
  32. #  subsystems developed elsewhere, which contain other copyright notices
  33. #  in their source text.
  34. #  
  35. #  The Harvest software was developed by the Internet Research Task
  36. #  Force Research Group on Resource Discovery (IRTF-RD).  The Harvest
  37. #  software may be used for academic, research, government, and internal
  38. #  business purposes without charge.  If you wish to sell or distribute
  39. #  the Harvest software to commercial clients or partners, you must
  40. #  license the software.  See
  41. #  http://harvest.cs.colorado.edu/harvest/copyright,licensing.html#licensing.
  42. #  
  43. #  The Harvest software is provided ``as is'', without express or
  44. #  implied warranty, and with no support nor obligation to assist in its
  45. #  use, correction, modification or enhancement.  We assume no liability
  46. #  with respect to the infringement of copyrights, trade secrets, or any
  47. #  patents, and are not responsible for consequential damages.  Proper
  48. #  use of the Harvest software is entirely the responsibility of the user.
  49. #  
  50. #  For those who are using Harvest for non-commercial purposes, you may
  51. #  make derivative works, subject to the following constraints:
  52. #  
  53. #  - You must include the above copyright notice and these accompanying 
  54. #    paragraphs in all forms of derivative works, and any documentation 
  55. #    and other materials related to such distribution and use acknowledge 
  56. #    that the software was developed at the above institutions.
  57. #  
  58. #  - You must notify IRTF-RD regarding your distribution of the 
  59. #    derivative work.
  60. #  
  61. #  - You must clearly notify users that your are distributing a modified 
  62. #    version and not the original Harvest software.
  63. #  
  64. #  - Any derivative product is also subject to the restrictions of the 
  65. #    copyright, including distribution and use limitations.
  66. #  
  67. #  
  68. package soif;
  69.  
  70. $soif'debug = 0;
  71. $soif'input = 'STDIN';
  72. $soif'output = 'STDOUT';
  73. $soif'sort_on_output = 1;
  74.  
  75. #
  76. #  soif'parse - $soif'input is the file descriptor from which to read SOIF.
  77. #              Returns an associative array containing the SOIF,
  78. #        the template type, and the URL.
  79. #
  80. sub soif'parse {
  81.     print "Inside soif'parse.\n" if ($soif'debug);
  82.  
  83.         return () if (eof($soif'input));       # DW
  84.     local($template_type) = "UNKNOWN";
  85.     local($url) = "UNKNOWN";
  86.     local(%SOIF);
  87.     undef %SOIF;
  88.  
  89.     while (<$soif'input>) {
  90.         print "READING input line: $_\n" if ($soif'debug);
  91.         last if (/^\@\S+\s*{\s*\S+\s*$/o);
  92.     }
  93.     if (/^\@(\S+)\s*{\s*(\S+)\s*$/o) {
  94.         $template_type = $1, $url = $2 
  95.     } else {
  96.         return ($template_type, $url, %SOIF);    # done
  97.     }
  98.  
  99.     while (<$soif'input>) {
  100.                 if (/^\s*([^{]+){(\d+)}:\t(.*\n)/o) {
  101.             $attr = $1;
  102.             $vsize = $2;
  103.             $value = $3;
  104.             if (length($value) < $vsize) {
  105.                 $nleft = $vsize - length($value);
  106.                 $end_value = "";
  107.                 $x = read($soif'input, $end_value, $nleft);
  108.                 die "Cannot read $nleft bytes: $!" 
  109.                     if ($x != $nleft);
  110.                 $value .= $end_value;
  111.                 undef $end_value;
  112.             }
  113.             chop($SOIF{$attr} = $value);
  114.             next;
  115.         } 
  116.         last if (/^}/o);
  117.     }
  118.  
  119.     return ($template_type, $url, %SOIF);
  120. }
  121.  
  122. #
  123. #  soif'print - $soif'output is the file descriptor to write SOIF.
  124. #
  125. sub soif'print {
  126.     print "Inside soif'print.\n" if ($soif'debug);
  127.     local($template_type, $url, %SOIF) = @_;
  128.  
  129.     # Write SOIF header, body, and trailer
  130.     print $soif'output "\@$template_type { $url\n";
  131.     if ($soif'sort_on_output) {
  132.         foreach $k (sort keys %SOIF) {
  133.             next if (length($SOIF{$k}) < 1);
  134.             &soif'print_item($k, $SOIF{$k});
  135.         }
  136.     } else {
  137.         foreach $k (keys %SOIF) {
  138.             next if (length($SOIF{$k}) < 1);
  139.             &soif'print_item($k, $SOIF{$k});
  140.         }
  141.     }
  142.     print $soif'output "}\n";
  143. }
  144.  
  145. sub soif'print_item {
  146.     local($k, $v) = @_;
  147.     print $soif'output "$k" , "{", length($v), "}:\t";
  148.     print $soif'output $v, "\n";
  149. }
  150. 1;
  151.